home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / utils / speedbspec.el.z / speedbspec.el
Encoding:
Text File  |  1998-05-21  |  10.5 KB  |  306 lines
  1. ;;; speedbspec --- Buffer specialized configurations for speedbar
  2.  
  3. ;; Copyright (C) 1997 Eric M. Ludlam
  4. ;;
  5. ;; Author: Eric M. Ludlam <zappo@gnu.ai.mit.edu>
  6. ;; Version: 0.1
  7. ;; Keywords: file, tags, tools
  8. ;; X-RCS: $Id: speedbspec.el,v 1.5 1997/06/04 02:44:19 zappo Exp $
  9. ;;
  10. ;; This program is free software; you can redistribute it and/or modify
  11. ;; it under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation; either version 2, or (at your option)
  13. ;; any later version.
  14. ;;
  15. ;; This program is distributed in the hope that it will be useful,
  16. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. ;; GNU General Public License for more details.
  19. ;;
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with this program; if not, you can either send email to this
  22. ;; program's author (see below) or write to:
  23. ;;
  24. ;;              The Free Software Foundation, Inc.
  25. ;;              675 Mass Ave.
  26. ;;              Cambridge, MA 02139, USA.
  27. ;;
  28. ;; Please send bug reports, etc. to zappo@gnu.ai.mit.edu.
  29. ;;
  30.  
  31. ;;; Commentary:
  32. ;;
  33. ;;   Speedbar provides a frame in which files, and locations in
  34. ;; files are displayed.  These functions provide some mode-specific
  35. ;; displays for some existing emacs modes.
  36. ;;
  37. ;;   To provide special service to all the modes supported by this file,
  38. ;; put the following in your .emacs file.
  39. ;;
  40. ;; (require 'speedbspec)
  41. ;;
  42. ;;   This will load in the known functions, and the mode-enabling code
  43. ;; into 'change-major-mode-hook.
  44. ;;
  45. ;;   This file requires speedbar.
  46.  
  47. ;;; Change log:
  48. ;;  0.1 - Initial revision requiring speedbar 0.5
  49.  
  50. ;;; Code:
  51. (require 'speedbar)
  52.  
  53. ;;; Generic add-new-special-mode stuff
  54. ;;
  55. (defvar speedbar-localized-buffer-queue nil
  56.   "List of buffers to localize for speedbar.")
  57.  
  58. (defun speedbar-add-localized-speedbar-support-to-q ()
  59.   "Add speedbar support to all buffers in `speedbar-localized-buffer-queue'."
  60.   (remove-hook 'post-command-hook
  61.            'speedbar-add-localized-speedbar-support-to-q)
  62.   (while speedbar-localized-buffer-queue
  63.     (speedbar-add-localized-speedbar-support
  64.      (car speedbar-localized-buffer-queue))
  65.     (setq speedbar-localized-buffer-queue
  66.       (cdr speedbar-localized-buffer-queue))))
  67.  
  68. (defun speedbar-add-localized-speedbar-support (buffer)
  69.   "Add localized speedbar support to BUFFER's mode if it is available."
  70.   (if (not (buffer-live-p buffer))
  71.       nil
  72.     (save-excursion
  73.       (set-buffer buffer)
  74.       (save-match-data
  75.     (let ((ms (symbol-name major-mode))
  76.           v tmp)
  77.       (if (not (string-match "-mode$" ms))
  78.           nil ;; do nothing to broken mode
  79.         (setq ms (substring ms 0 (match-beginning 0)))
  80.         (setq v (intern-soft (concat ms "-speedbar-buttons")))
  81.         (if (not v)
  82.         nil ;; do nothing if not defined
  83.           (make-local-variable 'speedbar-special-mode-expansion-list)
  84.           (setq speedbar-special-mode-expansion-list (list v))
  85.           (setq v (intern-soft (concat ms "-speedbar-menu-items")))
  86.           (if (not v)
  87.           nil ;; don't add special menus
  88.         (make-local-variable 'speedbar-easymenu-definition-special)
  89.         (setq speedbar-easymenu-definition-special
  90.               (symbol-value v))))))))))
  91.   
  92. (defun speedbar-change-major-mode ()
  93.   "Run when the major mode is changed."
  94.   (setq speedbar-localized-buffer-queue
  95.     (add-to-list 'speedbar-localized-buffer-queue (current-buffer)))
  96.   (add-hook 'post-command-hook 'speedbar-add-localized-speedbar-support-to-q))
  97.  
  98. (add-hook 'change-major-mode-hook 'speedbar-change-major-mode)
  99. (add-hook 'find-file-hooks 'speedbar-change-major-mode)
  100.  
  101. ;;; Info specific code
  102. ;;
  103. (defvar Info-last-speedbar-node nil
  104.   "Last node viewed with speedbar in the form '(NODE FILE).")
  105.  
  106. (defvar Info-speedbar-menu-items
  107.   '(["Browse Item On Line" speedbar-edit-line t])
  108.   "Additional menu-items to add to speedbar frame.")
  109.  
  110. (defun Info-speedbar-buttons (buffer)
  111.   "Create a speedbar display to help navigation in an Info file.
  112. BUFFER is the buffer speedbar is requesting buttons for."
  113.   (goto-char (point-min))
  114.   (if (and (looking-at "<Directory>")
  115.        (save-excursion
  116.          (set-buffer buffer)
  117.          (and (equal (car Info-last-speedbar-node) Info-current-node)
  118.           (equal (cdr Info-last-speedbar-node) Info-current-file))))
  119.       nil
  120.     (erase-buffer)
  121.     (speedbar-insert-button "<Directory>" 'info-xref 'highlight
  122.                 'Info-speedbar-button
  123.                 'Info-directory)
  124.     (speedbar-insert-button "<Top>" 'info-xref 'highlight
  125.                 'Info-speedbar-button
  126.                 'Info-top-node)
  127.     (speedbar-insert-button "<Last>" 'info-xref 'highlight
  128.                 'Info-speedbar-button
  129.                 'Info-last)
  130.     (speedbar-insert-button "<Up>" 'info-xref 'highlight
  131.                 'Info-speedbar-button
  132.                 'Info-up)
  133.     (speedbar-insert-button "<Next>" 'info-xref 'highlight
  134.                 'Info-speedbar-button
  135.                 'Info-next)
  136.     (speedbar-insert-button "<Prev>" 'info-xref 'highlight
  137.                 'Info-speedbar-button
  138.                 'Info-prev)
  139.     (let ((completions nil))
  140.       (save-excursion
  141.     (set-buffer buffer)
  142.     (setq Info-last-speedbar-node
  143.           (cons Info-current-node Info-current-file))
  144.     (goto-char (point-min))
  145.     ;; Always skip the first one...
  146.     (re-search-forward "\n\\* \\([^:\t\n]*\\):" nil t)
  147.     (while (re-search-forward "\n\\* \\([^:\t\n]*\\):" nil t)
  148.       (setq completions (cons (buffer-substring (match-beginning 1)
  149.                             (match-end 1))
  150.                   completions))))
  151.       (setq completions (nreverse completions))
  152.       (while completions
  153.     (speedbar-make-tag-line nil nil nil nil
  154.                 (car completions) 'Info-speedbar-menu
  155.                 nil 'info-node 0)
  156.     (setq completions (cdr completions))))))
  157.  
  158. (defun Info-speedbar-button (text token indent)
  159.   "Called when user clicks <Directory> from speedbar.
  160. TEXT, TOKEN, and INDENT are unused."
  161.   (speedbar-with-attached-buffer
  162.    (funcall token)
  163.    (setq Info-last-speedbar-node nil)
  164.    (speedbar-update-contents)))
  165.  
  166. (defun Info-speedbar-menu (text token indent)
  167.   "Goto the menu node specified in TEXT.
  168. TOKEN and INDENT are not used."
  169.   (speedbar-with-attached-buffer
  170.    (Info-menu text)
  171.    (setq Info-last-speedbar-node nil)
  172.    (speedbar-update-contents)))
  173.  
  174. ;;; RMAIL specific code
  175. ;;
  176. (defvar rmail-speedbar-last-user nil
  177.   "The last user to be displayed in the speedbar.")
  178.  
  179. (defvar rmail-speedbar-menu-items
  180.   '(["Browse Item On Line" speedbar-edit-line t]
  181.     ["Move message to folder" rmail-move-message-to-folder-on-line
  182.      (save-excursion (beginning-of-line)
  183.              (looking-at "<M> "))])
  184.   "Additional menu-items to add to speedbar frame.")
  185.  
  186. (defun rmail-speedbar-buttons (buffer)
  187.   "Create buttons for BUFFER containing rmail messages.
  188. Click on the address under Reply to: to reply to this person.
  189. Under Folders: Click a name to read it, or on the <M> to move the
  190. current message into that RMAIL folder."
  191.   (let ((from nil))
  192.     (save-excursion
  193.       (set-buffer buffer)
  194.       (goto-char (point-min))
  195.       (if (not (re-search-forward "^Reply-To: " nil t))
  196.       (if (not (re-search-forward "^From:? " nil t))
  197.           (setq from t)))
  198.       (if from
  199.       nil
  200.     (setq from (buffer-substring (point) (save-excursion
  201.                            (end-of-line)
  202.                            (point))))))
  203.     (goto-char (point-min))
  204.     (if (and (looking-at "Reply to:")
  205.          (equal from rmail-speedbar-last-user))
  206.     nil
  207.       (setq rmail-speedbar-last-user from)
  208.       (erase-buffer)
  209.       (insert "Reply To:\n")
  210.       (if (stringp from)
  211.       (speedbar-insert-button from 'speedbar-directory-face 'highlight
  212.                   'rmail-speedbar-button 'rmail-reply))
  213.       (insert "Folders:\n")
  214.       (let* ((case-fold-search nil)
  215.          (df (directory-files (save-excursion (set-buffer buffer)
  216.                           default-directory)
  217.                   nil "^[A-Z0-9]+\\(\\.[A-Z0-9]+\\)?$")))
  218.     (while df
  219.       (speedbar-insert-button "<M>" 'speedbar-button-face 'highlight
  220.                   'rmail-speedbar-move-message (car df))
  221.       (speedbar-insert-button (car df) 'speedbar-file-face 'highlight
  222.                   'rmail-speedbar-find-file nil t)
  223.       (setq df (cdr df)))))))
  224.  
  225. (defun rmail-speedbar-button (text token indent)
  226.   "Execute an rmail command specified by TEXT.
  227. The command used is TOKEN.  INDENT is not used."
  228.   (speedbar-with-attached-buffer
  229.    (funcall token t)))
  230.  
  231. (defun rmail-speedbar-find-file (text token indent)
  232.   "Load in the rmail file TEXT.
  233. TOKEN and INDENT are not used."
  234.   (speedbar-with-attached-buffer
  235.    (message "Loading in RMAIL file %s..." text)
  236.    (find-file text)))
  237.  
  238. (defun rmail-move-message-to-folder-on-line ()
  239.   "If the current line is a folder, move current message to it."
  240.   (interactive)
  241.   (save-excursion
  242.     (beginning-of-line)
  243.     (if (re-search-forward "<M> " (save-excursion (end-of-line) (point)) t)
  244.     (progn
  245.       (forward-char -2)
  246.       (speedbar-do-function-pointer)))))
  247.  
  248. (defun rmail-speedbar-move-message (text token indent)
  249.   "From button TEXT, copy current message to the rmail file specified by TOKEN.
  250. TEXT and INDENT are not used."
  251.   (speedbar-with-attached-buffer
  252.    (message "Moving message to %s" token)
  253.    (rmail-output-to-rmail-file token)))
  254.  
  255. ;;; W3 speedbar help
  256. (defvar w3-speedbar-last-buffer nil
  257.   "The last buffer shown by w3-speedbar.")
  258.  
  259. (defun w3-speedbar-buttons (buffer)
  260.   "Create speedbar buttons for the current web BUFFER displayed in w3 mode."
  261.   (save-excursion
  262.     (goto-char (point-min))
  263.     (if (and (looking-at "History:") (equal w3-speedbar-last-buffer buffer))
  264.     nil
  265.       (setq w3-speedbar-last-buffer buffer)
  266.       (erase-buffer)
  267.       (let ((links (save-excursion (set-buffer buffer) (w3-only-links)))
  268.         (part nil))
  269.     (insert "History:\n")
  270.     ;; This taken out of w3 which was used to create the history list,
  271.     ;; and is here modified to create the speedbar buttons
  272.     (cl-maphash
  273.      (function
  274.       (lambda (url desc)
  275.         (speedbar-insert-button (w3-speedbar-shorten-button url)
  276.                     'speedbar-directory-face 'highlight
  277.                     'w3-speedbar-link url)))
  278.      url-history-list)
  279.     (insert "Links:\n")
  280.     (while links
  281.       (setq part (car (cdr (member 'href (car links))))
  282.         links (cdr links))
  283.       (speedbar-insert-button (w3-speedbar-shorten-button part)
  284.                   'speedbar-file-face 'highlight
  285.                   'w3-speedbar-link part))))))
  286.     
  287. (defun w3-speedbar-shorten-button (button)
  288.   "Takes text BUTTON and shortens it as much as possible."
  289.   ;; I should make this more complex, but I'm not sure how...
  290.   (let ((fnnd (file-name-nondirectory button)))
  291.     (if (< 0 (length fnnd))
  292.     fnnd
  293.       (if (string-match "\\(ht\\|f\\)tp://" button)
  294.       (setq button (substring button (match-end 0))))
  295.       (if (string-match "/$" button)
  296.       (setq button (substring button 0 (match-beginning 0))))
  297.       button)))
  298.  
  299. (defun w3-speedbar-link (text token indent)
  300.   "Follow link described by TEXT which has the URL TOKEN.
  301. INDENT is not used."
  302.   (speedbar-with-attached-buffer (w3-fetch token)))
  303.  
  304. (provide 'speedbspec)
  305. ;;; speedbspec ends here
  306.